home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / dev / m2 / ModGen.lha / ModGen / Source / MGTools.mod < prev    next >
Text File  |  1995-04-17  |  54KB  |  1,307 lines
  1. (*---------------------------------------------------------------------------
  2.   :Program.    MGTools.mod
  3.   :Contents.   Modula-2 SourceCode Generator für GadgetToolsBox 2.x
  4.   :Author.     Frank Lömker
  5.   :Copyright.  FreeWare
  6.   :Language.   Modula-2
  7.   :Translator. Turbo Modula-2 V1.40
  8.   :Imports.    GadToolsBox [Jan van den Baard]
  9.   :History.    1.0 [Frank] 17-Apr-95
  10.   :History.        ModGen basiert direkt auf OG V37.11 von Thomas Igracki
  11.   :History.        und GenOberon V1.0 von Kai Bolay und Jan van den Baard.
  12.   :Bugs.       keine bekannt
  13. ---------------------------------------------------------------------------*)
  14.  
  15. IMPLEMENTATION MODULE MGTools;
  16.  
  17. FROM SYSTEM IMPORT ADR,ADDRESS,CAST,LONGSET,BITSET,STRING;
  18. IMPORT
  19.   e:=Exec, I:=Intuition, G:=Graphics, d:=Dos, u:=Utility, gt:=GadTools,
  20.   C:=Classes, df:=DiskFont, gtx:=GadToolsBox, m:=ModeKeys, st:=String, m2:=M2Lib;
  21.  
  22. TYPE
  23.   numKindsType = ARRAY [0..gt.NUM_KINDS-1] OF STRING;
  24.   goKindsType = numKindsType;
  25.   goIdcmpType = numKindsType;
  26.   goTypesType = ARRAY  [0..3] OF STRING;
  27.   BoolsArrayType = ARRAY [0..gt.NUM_KINDS-1] OF BOOLEAN;
  28.  
  29. CONST
  30.   palMonitor  = CAST (LONGSET, m.PAL_MONITOR_ID);
  31.   ntscMonitor = CAST (LONGSET, m.NTSC_MONITOR_ID);
  32.  
  33.   superLaceKeyLs = CAST (LONGSET, m.SUPERLACE_KEY);
  34.   hiresLaceKeyLs = CAST (LONGSET, m.HIRESLACE_KEY);
  35.   loresLaceKeyLs = CAST (LONGSET, m.LORESLACE_KEY);
  36.   superKeyLs     = CAST (LONGSET, m.SUPER_KEY);
  37.   hiresKeyLs     = CAST (LONGSET, m.HIRES_KEY);
  38.  
  39. VAR goKinds : goKindsType;
  40.     goIdcmp : goIdcmpType;
  41.     goTypes : goTypesType;
  42.     FalseArray : BoolsArrayType;
  43.  
  44. PROCEDURE InitConsts;
  45. BEGIN
  46.   goKinds:=["GENERIC", "BUTTON",  "CHECKBOX",
  47.             "INTEGER", "LISTVIEW","MX",
  48.             "NUMBER",  "CYCLE",   "PALETTE",
  49.             "SCROLLER","RESERVED","SLIDER",
  50.             "STRING",  "TEXT"];
  51.   goIdcmp:=["I.GADGETUP", "gt.BUTTONIDCMP","gt.CHECKBOXIDCMP",
  52.             "gt.INTEGERIDCMP",      "gt.LISTVIEWIDCMP","gt.MXIDCMP",
  53.             "LONGSET(gt.NUMBERIDCMP)","gt.CYCLEIDCMP",   "gt.PALETTEIDCMP",
  54.             "gt.SCROLLERIDCMP",     "RESERVED",         "gt.SLIDERIDCMP",
  55.             "gt.STRINGIDCMP",       "LONGSET(gt.TEXTIDCMP)"];
  56.   goTypes:=["NM_END","NM_TITLE","NM_ITEM","NM_SUB"];
  57.   FalseArray:=[FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE,FALSE];
  58. END InitConsts;
  59.  
  60. VAR goDone     : BoolsArrayType;
  61.     FixUpNumPos: LONGINT;
  62.     JoinedInWindow,ListViewLists: BOOLEAN;
  63.  
  64. PROCEDURE FPrintF (fh: d.FileHandlePtr;format: STRING;a1: ADDRESS);
  65. BEGIN
  66.   d.VFPrintf (fh,format,ADR(a1));
  67. END FPrintF;
  68.  
  69. PROCEDURE FPrintF2 (fh:d.FileHandlePtr;format:STRING;a1,a2: ADDRESS);
  70. BEGIN
  71.   d.VFPrintf (fh,format,ADR(a1));
  72. END FPrintF2;
  73.  
  74. PROCEDURE FPrintF3 (fh:d.FileHandlePtr;format:STRING;a1,a2,a3: ADDRESS);
  75. BEGIN
  76.   d.VFPrintf (fh,format,ADR(a1));
  77. END FPrintF3;
  78.  
  79. PROCEDURE FPrintF4 (fh:d.FileHandlePtr;format:STRING;a1,a2,a3,a4: ADDRESS);
  80. BEGIN
  81.   d.VFPrintf (fh,format,ADR(a1));
  82. END FPrintF4;
  83.  
  84. PROCEDURE FPrintF5 (fh:d.FileHandlePtr;format:STRING;a1,a2,a3,a4,a5: ADDRESS);
  85. BEGIN
  86.   d.VFPrintf (fh,format,ADR(a1));
  87. END FPrintF5;
  88.  
  89. PROCEDURE FPutS (fh: d.FileHandlePtr; str : STRING);
  90. BEGIN
  91.   d.FPuts (fh,str);
  92. END FPutS;
  93.  
  94. PROCEDURE FPutS2 (str : STRING);
  95. BEGIN
  96.   d.FPuts (file,str); d.FPuts (fdef,str);
  97. END FPutS2;
  98.  
  99. PROCEDURE MarkNumber;
  100. BEGIN FixUpNumPos := d.Seek (file, 0, d.OFFSET_CURRENT); FPutS (file, "0000");
  101. END MarkNumber;
  102.  
  103. PROCEDURE FixNumber (num: INTEGER);
  104. VAR curpos: LONGINT;
  105. BEGIN
  106.   curpos := d.Seek (file, FixUpNumPos, d.OFFSET_BEGINNING);
  107.   FPrintF (file, "%4ld", num);
  108.   d.Seek (file, curpos, d.OFFSET_BEGINNING);
  109. END FixNumber;
  110.  
  111. PROCEDURE SeekBack (num: INTEGER); (* Seek num pos backwards *)
  112. BEGIN d.Seek (file, -num, d.OFFSET_CURRENT);
  113. END SeekBack;
  114.  
  115. (* --- Check for the presence of GETFILE and joined LISTVIEWS.
  116.    --- This routine is called for each window that get's generated. *)
  117. PROCEDURE CheckItOut (pw: gtx.ProjectWindowPtr);
  118. VAR eng: gtx.ExtNewGadgetPtr;
  119. BEGIN
  120.   JoinedInWindow := FALSE; GetFileInWindow := FALSE;
  121.   eng := pw^.gadgets.head;
  122.   WHILE (eng^.succ # NIL) & ~(GetFileInWindow & JoinedInWindow) DO
  123.     IF (eng^.kind = gt.LISTVIEW_KIND) & (gtx.NeedLock IN eng^.flags) THEN JoinedInWindow := TRUE END;
  124.     IF eng^.kind = gt.GENERIC_KIND THEN GetFileInWindow := TRUE END;
  125.     eng := eng^.succ;
  126.   END;
  127. END CheckItOut;
  128.  
  129. (* --- Check for the presence of GETFILE and ListView at all *)
  130. PROCEDURE CheckGetFile;
  131. VAR eng: gtx.ExtNewGadgetPtr; pw: gtx.ProjectWindowPtr;
  132. BEGIN
  133.   GetFilePresent := FALSE; ListViewPresent := FALSE; ListViewLists:=FALSE;
  134.   pw := Projects.head;
  135.   WHILE (pw^.succ # NIL) & ~(GetFilePresent AND ListViewPresent) DO
  136.     eng := pw^.gadgets.head;
  137.     WHILE (eng^.succ # NIL) & ~(GetFilePresent AND ListViewPresent) DO
  138.       IF eng^.kind = gt.GENERIC_KIND THEN GetFilePresent := TRUE
  139.       ELSIF eng^.kind = gt.LISTVIEW_KIND THEN ListViewPresent := TRUE; END;
  140.       eng := eng^.succ;
  141.     END;
  142.     pw := pw^.succ;
  143.   END;
  144. END CheckGetFile;
  145.  
  146. (* --- Write placement flags. *)
  147. PROCEDURE WritePlaceFlags (flags: LONGSET);
  148. BEGIN
  149.   IF flags = {} THEN RETURN END;
  150.  
  151.   IF    gt.PLACETEXT_LEFT  <= flags THEN FPutS (file, "gt.PLACETEXT_LEFT+")
  152.   ELSIF gt.PLACETEXT_RIGHT <= flags THEN FPutS (file, "gt.PLACETEXT_RIGHT+")
  153.   ELSIF gt.PLACETEXT_ABOVE <= flags THEN FPutS (file, "gt.PLACETEXT_ABOVE+")
  154.   ELSIF gt.PLACETEXT_BELOW <= flags THEN FPutS (file, "gt.PLACETEXT_BELOW+")
  155.   ELSIF gt.PLACETEXT_IN    <= flags THEN FPutS (file, "gt.PLACETEXT_IN+")
  156.   END;
  157.   IF gt.NG_HIGHLABEL <= flags THEN FPutS (file, "gt.NG_HIGHLABEL+") END;
  158.  
  159.   SeekBack(1);
  160. END WritePlaceFlags;
  161.  
  162. (* --- Write DisplayID flags. *)
  163. PROCEDURE WriteIDFlags (flags: LONGSET);
  164. BEGIN
  165.   IF    palMonitor  * flags = palMonitor  THEN FPutS (file, "m.PAL_MONITOR_ID+")
  166.   ELSIF ntscMonitor * flags = ntscMonitor THEN FPutS (file, "m.NTSC_MONITOR_ID+")
  167.                                           ELSE FPutS (file, "m.DEFAULT_MONITOR_ID+")
  168.   END;
  169.  
  170.   IF    superLaceKeyLs * flags = superLaceKeyLs THEN FPutS (file, "m.SUPERLACE_KEY+")
  171.   ELSIF hiresLaceKeyLs * flags = hiresLaceKeyLs THEN FPutS (file, "m.HIRESLACE_KEY+")
  172.   ELSIF loresLaceKeyLs * flags = loresLaceKeyLs THEN FPutS (file, "m.LORESLACE_KEY+")
  173.   ELSIF superKeyLs     * flags = superKeyLs THEN FPutS (file, "m.SUPER_KEY+")
  174.   ELSIF hiresKeyLs     * flags = hiresKeyLs THEN FPutS (file, "m.HIRES_KEY+")
  175.                                             ELSE FPutS (file, "m.LORES_KEY+")
  176.   END;
  177.  
  178.   SeekBack(1);
  179.   FPutS (file, ",\n");
  180. END WriteIDFlags;
  181.  
  182. (* --- Write the IntuiText drawmode flags. *)
  183. PROCEDURE WriteDrMd (drmd: SHORTSET);
  184. BEGIN
  185.   IF G.JAM2*drmd # {} THEN FPutS (file, "g.JAM2") ELSE FPutS (file, "g.JAM1") END;
  186.   IF G.COMPLEMENT <= drmd THEN FPutS (file, "+g.COMPLEMENT") END;
  187.   IF G.INVERSVID  <= drmd THEN FPutS (file, "+g.INVERSVID") END;
  188. END WriteDrMd;
  189.  
  190. (* --- Write GadTools IDCMP flags. *)
  191. PROCEDURE WriteGadToolsIDCMP (pw: gtx.ProjectWindowPtr);
  192. VAR eng: gtx.ExtNewGadgetPtr;
  193. BEGIN
  194.   goDone := FalseArray;
  195.   eng := pw^.gadgets.head;
  196.   WHILE eng^.succ # NIL DO
  197.     IF ~goDone [eng^.kind] THEN
  198.       FPrintF (file, ADR("%s+"), goIdcmp[eng^.kind]);
  199.       goDone[eng^.kind] := TRUE;
  200.       IF eng^.kind = gt.SCROLLER_KIND THEN
  201.         IF gtx.GTX_TagInArray (LONGCARD(gt.GTSC_Arrows), CAST(u.TagPtr,eng^.tags)) THEN
  202.           FPutS (file, "gt.ARROWIDCMP+")
  203.         END;
  204.       END;
  205.     END;
  206.     eng := eng^.succ;
  207.   END;
  208. END WriteGadToolsIDCMP;
  209.  
  210. (* --- Write IDCMP flags. *)
  211. PROCEDURE WriteIDCMPFlags (idcmp: LONGSET; pw: gtx.ProjectWindowPtr);
  212. BEGIN
  213.   IF idcmp = {} THEN FPutS (file, "{},\n"); RETURN END;
  214.  
  215.   WriteGadToolsIDCMP (pw);
  216.  
  217.   FPutS (file, "\n                    ");
  218.  
  219.   IF I.GADGETUP <= idcmp THEN
  220.     IF ~goDone[0 ] & ~goDone[1 ] &
  221.        ~goDone[2 ] & ~goDone[3 ] &
  222.        ~goDone[4 ] & ~goDone[7 ] &
  223.        ~goDone[8 ] & ~goDone[9 ] &
  224.        ~goDone[11] & ~goDone[12] THEN FPutS (file, "I.GADGETUP+");
  225.     END;
  226.   END;
  227.  
  228.   IF I.GADGETDOWN <= idcmp THEN
  229.     IF ~goDone[4] & ~goDone[5 ] & ~goDone[9] & ~goDone[11] THEN
  230.       FPutS (file, "I.GADGETDOWN+")
  231.     END;
  232.   END;
  233.  
  234.   IF I.INTUITICKS <= idcmp THEN
  235.     IF ~goDone[4] & ~goDone[9] THEN FPutS (file, "I.INTUITICKS+") END;
  236.   END;
  237.  
  238.   IF I.MOUSEMOVE <= idcmp THEN
  239.     IF ~goDone[4 ] & ~goDone[9 ] & ~goDone[11] THEN
  240.       FPutS (file, "I.MOUSEMOVE+")
  241.     END;
  242.   END;
  243.  
  244.   IF I.MOUSEBUTTONS <= idcmp THEN
  245.     IF ~goDone[4] & ~goDone[9] THEN FPutS (file, "I.MOUSEBUTTONS+") END;
  246.   END;
  247.  
  248.   IF I.SIZEVERIFY    <= idcmp THEN FPutS (file, "I.SIZEVERIFY+") END;
  249.   IF I.NEWSIZE       <= idcmp THEN FPutS (file, "I.NEWSIZE+") END;
  250.  
  251.   IF I.REQSET        <= idcmp THEN FPutS (file, "I.REQSET+") END;
  252.   IF I.MENUPICK      <= idcmp THEN FPutS (file, "I.MENUPICK+") END;
  253.   IF I.CLOSEWINDOW   <= idcmp THEN FPutS (file, "I.CLOSEWINDOW+") END;
  254.  
  255.   IF I.RAWKEY        <= idcmp THEN FPutS (file, "I.RAWKEY+") END;
  256.   IF I.REQVERIFY     <= idcmp THEN FPutS (file, "I.REQVERIFY+") END;
  257.   IF I.REQCLEAR      <= idcmp THEN FPutS (file, "I.REQCLEAR+") END;
  258.   IF I.MENUVERIFY    <= idcmp THEN FPutS (file, "I.MENUVERIFY+") END;
  259.   IF I.NEWPREFS      <= idcmp THEN FPutS (file, "I.NEWPREFS+") END;
  260.   IF I.DISKINSERTED  <= idcmp THEN FPutS (file, "I.DISKINSERTED+") END;
  261.  
  262.   IF I.DISKREMOVED    <= idcmp THEN FPutS (file, "I.DISKREMOVED+") END;
  263.   IF I.ACTIVEWINDOW   <= idcmp THEN FPutS (file, "I.ACTIVEWINDOW+") END;
  264.   IF I.INACTIVEWINDOW <= idcmp THEN FPutS (file, "I.INACTIVEWINDOW+") END;
  265.   IF I.DELTAMOVE      <= idcmp THEN FPutS (file, "I.DELTAMOVE+") END;
  266.   IF I.VANILLAKEY     <= idcmp THEN FPutS (file, "I.VANILLAKEY+") END;
  267.   IF I.IDCMPUPDATE    <= idcmp THEN FPutS (file, "I.IDCMPUPDATE+") END;
  268.  
  269.   IF I.MENUHELP      <= idcmp THEN FPutS (file, "I.MENUHELP+") END;
  270.   IF I.CHANGEWINDOW  <= idcmp THEN FPutS (file, "I.CHANGEWINDOW+") END;
  271.   IF I.REFRESHWINDOW <= idcmp THEN FPutS (file, "I.REFRESHWINDOW+") END;
  272.  
  273.   SeekBack(1);
  274.   FPutS (file, ",\n");
  275. END WriteIDCMPFlags;
  276.  
  277. (* --- Write window flags. *)
  278. PROCEDURE WriteWindowFlags (flags: LONGSET);
  279. BEGIN
  280.   IF I.WINDOWSIZING   <= flags THEN FPutS (file, "I.WINDOWSIZING+") END;
  281.   IF I.WINDOWDRAG     <= flags THEN FPutS (file, "I.WINDOWDRAG+") END;
  282.   IF I.WINDOWDEPTH    <= flags THEN FPutS (file, "I.WINDOWDEPTH+") END;
  283.   IF I.WINDOWCLOSE    <= flags THEN FPutS (file, "I.WINDOWCLOSE+") END;
  284.   IF I.SIZEBRIGHT     <= flags THEN FPutS (file, "I.SIZEBRIGHT+") END;
  285.   IF I.SIZEBBOTTOM <= flags THEN FPutS (file, "I.SIZEBBOTTOM+") END;
  286. (* IF I.SMART_REFRESH <= flags THEN FPutS (file, "I.SMART_REFRESH+") END; *)
  287.   IF I.SIMPLE_REFRESH  <= flags THEN FPutS (file, "I.SIMPLE_REFRESH+") END;
  288.   IF I.SUPER_BITMAP    <= flags THEN FPutS (file, "I.SUPER_BITMAP+") END;
  289.   IF I.OTHER_REFRESH * flags = I.OTHER_REFRESH THEN FPutS (file, "I.SIMPLE_REFRESH+I.SUPER_BITMAP+") END;
  290.   IF I.BACKDROP       <= flags THEN FPutS (file, "I.BACKDROP+") END;
  291.   IF I.REPORTMOUSE    <= flags THEN FPutS (file, "I.REPORTMOUSE+") END;
  292.   IF I.GIMMEZEROZERO  <= flags THEN FPutS (file, "I.GIMMEZEROZERO+") END;
  293.   IF I.BORDERLESS     <= flags THEN FPutS (file, "I.BORDERLESS+") END;
  294.   IF I.ACTIVATE       <= flags THEN FPutS (file, "I.ACTIVATE+") END;
  295.   IF I.RMBTRAP        <= flags THEN FPutS (file, "I.RMBTRAP+") END;
  296.  
  297.   SeekBack(1);
  298.   FPutS (file, ",\n");
  299. END WriteWindowFlags;
  300.  
  301. (* --- Write a single NewMenu structure. *)
  302. PROCEDURE WriteNewMenu (menu: gtx.ExtNewMenuPtr);
  303. VAR flags: BITSET;
  304. BEGIN
  305.   FPrintF (file, "    [gt.%s, ", goTypes[menu^.newMenu.nm_Type]);
  306.   IF menu^.newMenu.nm_Label # gt.NM_BARLABEL THEN
  307.     FPrintF (file, ADR('"%s", '), ADR(menu^.menuTitle));
  308.   ELSE
  309.     FPutS (file, "gt.NM_BARLABEL],\n");
  310.     RETURN;
  311.   END;
  312.   IF menu^.newMenu.nm_CommKey # NIL THEN
  313.      FPrintF (file, ADR('"%s", '), ADR(menu^.commKey));
  314.   ELSE FPutS (file, "NIL, "); END;
  315.   flags := menu^.newMenu.nm_Flags;
  316.   IF flags # {} THEN
  317.     IF menu^.newMenu.nm_Type = gt.NM_TITLE THEN
  318.       IF gt.NM_MENUDISABLED <= flags THEN FPutS (file, "gt.NM_MENUDISABLED+") END;
  319.     ELSE
  320.       IF gt.NM_ITEMDISABLED <= flags THEN FPutS (file, "gt.NM_ITEMDISABLED+") END;
  321.     END;
  322.     IF I.CHECKIT    <= flags THEN FPutS (file, "I.CHECKIT+") END;
  323.     IF I.CHECKED    <= flags THEN FPutS (file, "I.CHECKED+") END;
  324.     IF I.MENUTOGGLE <= flags THEN FPutS (file, "I.MENUTOGGLE+") END;
  325.     SeekBack(1);
  326.     FPutS (file,",");
  327.   ELSE FPutS (file,"{},"); END;
  328.  
  329.   FPrintF (file, ADR(" %ld],\n"), menu^.newMenu.nm_MutualExclude);
  330. END WriteNewMenu;
  331.  
  332. (* --- Write the NewMenu structures. *)
  333. PROCEDURE WriteMenus (end:BOOLEAN);
  334. VAR pw: gtx.ProjectWindowPtr;
  335.     menu,item,sub: gtx.ExtNewMenuPtr;
  336.     cnt: INTEGER;
  337. BEGIN
  338.   pw := Projects.head;
  339.   WHILE pw^.succ # NIL DO
  340.     IF pw^.menus.head^.succ # NIL THEN
  341.       IF end THEN
  342.         FPrintF2 (file,ADR("  %sNewMenu := GetMem (SIZE(%sMArray));\n"), ADR(pw^.name), ADR(pw^.name));
  343.         FPrintF (file,ADR("  %sNewMenu^ :=[\n"), ADR(pw^.name));
  344.       ELSE
  345.         FPrintF (file, ADR("TYPE %sMArray = ARRAY [0.."), ADR(pw^.name));
  346.         MarkNumber; cnt := 0;
  347.         FPrintF2 (file,ADR("] OF gt.NewMenu;\nVAR %sNewMenu : POINTER TO %sMArray;\n"), ADR(pw^.name), ADR(pw^.name));
  348.       END;
  349.       menu := pw^.menus.head;
  350.       WHILE menu^.succ # NIL DO
  351.         IF end THEN WriteNewMenu(menu); END; INC(cnt);
  352.         IF menu^.items # NIL THEN
  353.           item := menu^.items^.head;
  354.           WHILE item^.succ # NIL DO
  355.             IF end THEN WriteNewMenu(item); END; INC(cnt);
  356.             IF item^.items # NIL THEN
  357.               sub := item^.items^.head;
  358.               WHILE sub^.succ # NIL DO
  359.                 IF end THEN WriteNewMenu (sub); END; INC(cnt);
  360.                 sub := sub^.succ;
  361.               END;
  362.             END;
  363.             item := item^.succ;
  364.           END;
  365.         END;
  366.         menu := menu^.succ;
  367.       END; (* WHILE *)
  368.       IF end THEN FPutS (file, "    [gt.NM_END,NIL] ];\n");
  369.              ELSE FixNumber (cnt); END;
  370.     END;
  371.     pw := pw^.succ;
  372.   END; (* WHILE *)
  373. END WriteMenus;
  374.  
  375. PROCEDURE GetKey (str: (*@N*)ARRAY OF CHAR): CHAR; (*$ CopyDyn:=FALSE *)
  376. VAR s: STRING;
  377. BEGIN s := st.strchr (str,'_'); IF s = NIL THEN RETURN '' ELSE RETURN CAP(s^[1]) END;
  378. END GetKey;
  379.  
  380. (* --- Write the GadgetID defines. *)
  381. PROCEDURE WriteID ();
  382. VAR pw : gtx.ProjectWindowPtr;
  383.     eng: gtx.ExtNewGadgetPtr;
  384. BEGIN
  385.   pw := Projects.head;
  386.   WHILE pw^.succ # NIL DO
  387.     IF pw^.gadgets.head^.succ # NIL THEN
  388.       FPrintF (fdef, ADR('  %sHotKeys = "'),ADR(pw^.name));
  389.       eng := pw^.gadgets.head;
  390.       WHILE eng^.succ # NIL DO
  391.         (*$ StackParms:=TRUE *)
  392.         FPrintF (fdef, ADR("%lc"), ORD(GetKey(eng^.gadgetText)));
  393.         (*$ POP StackParms *)
  394.         eng := eng^.succ;
  395.       END;
  396.       FPutS (fdef, '";\n');
  397.  
  398.       eng := pw^.gadgets.head;
  399.       WHILE eng^.succ # NIL DO
  400.         FPrintF2 (fdef, ADR("  GD%-32s = %ld;\n"), ADR(eng^.gadgetLabel), eng^.newGadget.ng_GadgetID);
  401.         eng := eng^.succ;
  402.       END;
  403.       FPutS (fdef, "\n");
  404.     END;
  405.     pw := pw^.succ;
  406.   END; (* WHILE *)
  407. END WriteID;
  408.  
  409. (* --- Check FOR OpenFont source genertion. *)
  410. PROCEDURE CheckFont(): BOOLEAN;
  411. BEGIN
  412.   IF gtx.FontAdapt IN MainConfig.configFlags0 THEN RETURN FALSE END;
  413.   IF (GenOpenFont IN MConfig) AND
  414.      NOT (G.FPB_ROMFONT IN GuiData.font.ta_Flags) THEN RETURN TRUE END;
  415.   RETURN FALSE;
  416. END CheckFont;
  417.  
  418. (* Init the Windowcoordinates. *)
  419. PROCEDURE InitCoords;
  420. VAR pw: gtx.ProjectWindowPtr;
  421.     btop: LONGCARD;
  422. BEGIN
  423.   pw := Projects.head;
  424.   WHILE pw^.succ # NIL DO
  425.     FPrintF4 (file, ADR("  %sLeft := %ld;\n  %sTop := %ld;\n"),
  426.                     ADR(pw^.name), u.GetTagData (I.WA_Left,0,pw^.tags),
  427.                     ADR(pw^.name),u.GetTagData (I.WA_Top,0,pw^.tags));
  428.     IF ~(gtx.FontAdapt IN MainConfig.configFlags0) THEN
  429.       FPrintF (file, ADR("  %sWidth := "), ADR(pw^.name));
  430.       IF gtx.InnerWidth IN pw^.tagFlags THEN
  431.         FPrintF (file, ADR("%ld;\n"), pw^.innerWidth);
  432.       ELSE
  433.         FPrintF (file, ADR("%ld;\n"), u.GetTagData (I.WA_Width, NIL, pw^.tags));
  434.       END;
  435.  
  436.       FPrintF (file, ADR("  %sHeight := "), ADR(pw^.name));
  437.       IF gtx.InnerHeight IN pw^.tagFlags THEN
  438.         FPrintF (file, ADR("%ld;\n"), pw^.innerHeight);
  439.       ELSE
  440.         btop := pw^.topBorder;
  441.         FPrintF (file, ADR("%ld;\n"), u.GetTagData (I.WA_Height, NIL, pw^.tags) - btop);
  442.       END;
  443.     ELSE
  444.       FPrintF4 (file,ADR("  %sWidth := %ld;\n  %sHeight := %ld;\n"),ADR(pw^.name),pw^.innerWidth,ADR(pw^.name),pw^.innerHeight);
  445. (*    btop := pw^.topBorder;
  446.       FPrintF4 (file,ADR("  %sWidth := %ld;\n  %sHeight := %ld;\n"),
  447.                      ADR(pw^.name), u.GetTagData (I.WA_Width, NIL, pw^.tags),
  448.                      ADR(pw^.name),u.GetTagData (I.WA_Height, NIL, pw^.tags) - btop); *)
  449.     END;
  450.     pw := pw^.succ;
  451.   END; (* WHILE *)
  452. END InitCoords;
  453.  
  454. (* --- Write the necessary globals. *)
  455. PROCEDURE WriteGlob (scr,win:BOOLEAN);
  456. VAR pw: gtx.ProjectWindowPtr;
  457.     f:d.FileHandlePtr;
  458. BEGIN
  459.   pw := Projects.head;
  460.   WHILE pw^.succ # NIL DO
  461.     FPrintF2 (fdef,ADR("  %sCNT = %ld;\n"),ADR(pw^.name),gtx.GTX_CountNodes (ADR(pw^.gadgets)));
  462.     pw := pw^.succ;
  463.   END; (* WHILE *)
  464.  
  465.   FPutS  (fdef,"\nVAR\n");
  466.   IF NOT win THEN
  467.     FPutS (fdef,"  Scr: I.ScreenPtr;\n  VisualInfo: y.ADDRESS;\n");
  468.   END;
  469.  
  470.   pw := Projects.head;
  471.   WHILE pw^.succ # NIL DO
  472.     FPrintF (fdef, ADR("  %sWnd: I.WindowPtr;\n"), ADR(pw^.name));
  473.     IF pw^.gadgets.head^.succ # NIL THEN
  474.       FPrintF3 (fdef,ADR("  %sGList: I.GadgetPtr;\n  %sGadgets: ARRAY [0..%sCNT-1] OF I.GadgetPtr;\n"), ADR(pw^.name), ADR(pw^.name), ADR(pw^.name));
  475.     END;
  476.     IF pw^.menus.head^.succ # NIL THEN
  477.       FPrintF (fdef, ADR("  %sMenus: I.MenuPtr;\n"), ADR(pw^.name));
  478.     END;
  479.     IF LONGSET{gtx.Zoom,gtx.DefaultZoom} * pw^.tagFlags # LONGSET{} THEN
  480.       IF ~(I.WINDOWSIZING <= pw^.windowFlags) THEN
  481.         FPrintF (fdef, ADR("  %sZoom: ARRAY [0..3] OF INTEGER;\n"), ADR(pw^.name));
  482.       END;
  483.     END;
  484.     FPrintF4 (fdef, ADR("  %sLeft, %sTop,\n  %sWidth, %sHeight: INTEGER;\n"),
  485.                     ADR(pw^.name), ADR(pw^.name), ADR(pw^.name), ADR(pw^.name));
  486.     pw := pw^.succ
  487.   END;
  488.   IF GetFilePresent AND NOT scr THEN
  489.     FPutS (file,"VAR\n");
  490.     pw := Projects.head;
  491.     WHILE pw^.succ # NIL DO
  492.       CheckItOut (pw);
  493.       IF GetFileInWindow THEN
  494.         FPrintF (file, ADR("  %sGetImage: C.ObjectPtr;\n"), ADR(pw^.name));
  495.       END;
  496.       pw := pw^.succ;
  497.     END;
  498.   END;
  499.   IF NOT win THEN
  500.     IF scr THEN f:=fdef ELSE f:=file; END;
  501.     IF CheckFont() THEN FPutS (fdef, "  Font: g.TextFontPtr;\n") END;
  502.  
  503.     IF (gtx.FontAdapt IN MainConfig.configFlags0) AND
  504.        ((NOT GetFilePresent) OR scr) THEN
  505.       FPutS (file,"VAR\n");
  506.     END;
  507.  
  508.     IF gtx.FontAdapt IN MainConfig.configFlags0 THEN
  509.       FPutS (fdef,"  Font: g.TextAttrPtr;\n  Attr,Topaz80: g.TextAttr;\n");
  510.       FPutS (file,"  FontX, FontY: INTEGER;\n");
  511.       FPutS (f,   "  OffX, OffY: INTEGER;\n");
  512.     END;
  513.   END;  (* IF NOT win *)
  514.   IF NOT scr THEN
  515.     IF (gtx.FontAdapt IN MainConfig.configFlags0) AND (SysFont IN MConfig) THEN
  516.       pw := Projects.head;
  517.       WHILE pw^.succ # NIL DO
  518.         FPrintF (fdef, ADR("  %sFont: g.TextFontPtr;\n"), ADR(pw^.name));
  519.         pw := pw^.succ;
  520.       END;
  521.     END;
  522.   END;
  523.   FPutS2 (ADR("\n"));
  524. END WriteGlob;
  525.  
  526. PROCEDURE CountArray(arr:ARRAY OF STRING):LONGINT;
  527. VAR nr: INTEGER;
  528. BEGIN
  529.   nr:= 0;
  530.   WHILE (nr<=HIGH(arr)) AND (arr[nr]#NIL) DO
  531.     INC (nr);
  532.   END;
  533.   RETURN(nr);
  534. END CountArray;
  535.  
  536. (* --- Write the Cycle and Mx lables. *)
  537. PROCEDURE WriteLabels (end:BOOLEAN);
  538. VAR pw: gtx.ProjectWindowPtr;
  539.     eng: gtx.ExtNewGadgetPtr;
  540.     i,pnum: INTEGER;
  541.     labels: POINTER TO ARRAY [0..23] OF STRING;
  542. BEGIN
  543.   pw := Projects.head; pnum := 0;
  544.   WHILE pw^.succ # NIL DO
  545.     eng := pw^.gadgets.head;
  546.     WHILE eng^.succ # NIL DO
  547.       IF (eng^.kind = gt.CYCLE_KIND) OR (eng^.kind = gt.MX_KIND) THEN
  548.         IF (eng^.kind = gt.CYCLE_KIND) THEN
  549.           labels := CAST(ADDRESS,u.GetTagData (gt.GTCY_Labels, NIL, eng^.tags));
  550.         ELSE
  551.           labels := CAST(ADDRESS,u.GetTagData (gt.GTMX_Labels, NIL, eng^.tags));
  552.         END;
  553.         IF NOT end THEN
  554.           FPrintF3 (file, ADR("TYPE %s%ldLArray = ARRAY [0..%ld] OF y.STRING;\n"),
  555.                     ADR(eng^.gadgetLabel), pnum, CountArray(labels^));
  556.           FPrintF4 (file, ADR("VAR %s%ldLabels : %s%ldLArray;\n"), ADR(eng^.gadgetLabel), pnum, ADR(eng^.gadgetLabel), pnum);
  557.         ELSE
  558.           FPrintF2 (file, ADR("  %s%ldLabels := [\n"), ADR(eng^.gadgetLabel), pnum );
  559.           FOR i := 0 TO 23 DO
  560.             IF labels^[i]#NIL THEN
  561.               FPrintF (file, ADR('    "%s",\n'), labels^[i]);
  562.             END;
  563.           END;
  564.           FPutS (file, "    NIL];\n");
  565.         END;
  566.       END;
  567.       eng := eng^.succ;
  568.     END; (* WHILE *)
  569.     pw := pw^.succ; INC(pnum);
  570.   END; (* WHILE *)
  571. END WriteLabels;
  572.  
  573. PROCEDURE WriteList;
  574. VAR pw: gtx.ProjectWindowPtr;
  575.     eng: gtx.ExtNewGadgetPtr;
  576.     list: e.ListPtr;
  577.     pnum: INTEGER;
  578.     first:BOOLEAN;
  579. BEGIN
  580.   first:=TRUE;
  581.   pw := Projects.head; pnum := 0;
  582.   WHILE pw^.succ # NIL DO
  583.     eng := pw^.gadgets.head;
  584.     WHILE eng^.succ # NIL DO
  585.       IF eng^.kind = gt.LISTVIEW_KIND THEN
  586.         list := CAST(ADDRESS,u.GetTagData (gt.GTLV_Labels, 0, eng^.tags ));
  587.         IF (list # NIL) AND (list^.lh_Head^.ln_Succ # NIL) THEN
  588.           IF first THEN
  589.             FPutS (file, "VAR\n"); first:=FALSE;
  590.           END;
  591.           FPrintF2 (file, ADR("  %s%ldList: e.MinList;\n"), ADR(eng^.gadgetLabel), pnum);
  592.           FPrintF3 (file, ADR("  %s%ldNodes: ARRAY [0..%ld] OF e.Node;\n"), ADR(eng^.gadgetLabel), pnum, gtx.GTX_CountNodes (list)-1);
  593.           ListViewLists := TRUE;
  594.         END;
  595.       END;
  596.       eng := eng^.succ;
  597.     END; (* WHILE *)
  598.     pw := pw^.succ; INC(pnum);
  599.   END;(* WHILE *)
  600. END WriteList;
  601.  
  602. (* --- Write a single ListView Node. *)
  603.  
  604. PROCEDURE WriteNode (eng: gtx.ExtNewGadgetPtr; node: e.NodePtr; num,pnum: INTEGER);
  605. VAR list: e.ListPtr;
  606. BEGIN
  607.   list := CAST(ADDRESS,u.GetTagData (gt.GTLV_Labels, 0, eng^.tags));
  608.   IF list # NIL THEN
  609.     IF node^.ln_Succ # ADR(list^.lh_Tail) THEN
  610.       FPrintF3 (file, ADR("    [y.ADR (%s%ldNodes[%ld])"), ADR(eng^.gadgetLabel), pnum, num+1);
  611.     ELSE
  612.       FPrintF2 (file, ADR("    [y.ADR (%s%ldList.mlh_Tail)"), ADR(eng^.gadgetLabel), pnum);
  613.     END;
  614.     IF node^.ln_Pred = ADR(list^.lh_Head) THEN
  615.       FPrintF2 (file, ADR(", y.ADR (%s%ldList.mlh_Head),\n"), ADR(eng^.gadgetLabel), pnum);
  616.     ELSE
  617.       FPrintF3 (file, ADR(", y.ADR (%s%ldNodes[%ld]),\n"), ADR(eng^.gadgetLabel), pnum, num-1);
  618.     END;
  619.     FPrintF (file, ADR('     e.NT_UNKNOWN, 0, "%s"],\n'), node^.ln_Name);
  620.   ELSE FPutS (file,"    [],\n"); END;
  621. END WriteNode;
  622.  
  623. (* --- Write a ListView List/Node initialisation *)
  624.  
  625. PROCEDURE WriteNodes (pw: gtx.ProjectWindowPtr; pnum: INTEGER);
  626. VAR eng: gtx.ExtNewGadgetPtr;
  627.     node: e.NodePtr;
  628.     list: e.ListPtr;
  629.     nodenum: INTEGER;
  630. BEGIN
  631.   eng := pw^.gadgets.head;
  632.   WHILE eng^.succ # NIL DO
  633.     IF eng^.kind = gt.LISTVIEW_KIND THEN
  634.       list := CAST(ADDRESS,u.GetTagData (gt.GTLV_Labels, 0, eng^.tags));
  635.       IF list # NIL THEN
  636.         IF list^.lh_Head^.ln_Succ # NIL THEN
  637.           node := list^.lh_Head; nodenum := 0;
  638.           FPrintF2 (file, ADR("  %s%ldNodes:=[\n"),ADR(eng^.gadgetLabel), pnum);
  639.           WHILE node^.ln_Succ # NIL DO
  640.             WriteNode (eng, node, nodenum, pnum);
  641.             node := node^.ln_Succ; INC(nodenum);
  642.           END;
  643.           SeekBack (2);
  644.           FPutS (file," ];\n");
  645.           FPrintF4 (file, ADR("  %s%ldList:=[y.ADR (%s%ldNodes[0]), NIL,"),ADR(eng^.gadgetLabel[0]), pnum, ADR(eng^.gadgetLabel[0]), pnum);
  646.           FPrintF3 (file, ADR(" y.ADR (%s%ldNodes[%ld])];\n\n"), ADR(eng^.gadgetLabel[0]), pnum, nodenum-1);
  647. (*      ELSE
  648.           FPrintF4 (file, ADR("  %s%ldList.mlh_Head     := y.ADR (%s%ldList.tail);\n"), ADR(eng^.gadgetLabel[0]), pnum, ADR(eng^.gadgetLabel[0]), pnum);
  649.           FPrintF2 (file, ADR("  %s%ldList.mlh_Tail     := NIL;\n"), ADR(eng^.gadgetLabel[0]), pnum);
  650.           FPrintF4 (file, ADR("  %s%ldList.mlh_TailPred := y.ADR (%s%ldList.head);\n\n"), ADR(eng^.gadgetLabel[0]), pnum, ADR(eng^.gadgetLabel[0]), pnum);
  651. *)      END;
  652.       END;
  653.     END;
  654.     eng := eng^.succ;
  655.   END;
  656. END WriteNodes;
  657.  
  658. (* --- Write the TextAttr structure *)
  659. PROCEDURE WriteTextAttr (scr,end:BOOLEAN);
  660. VAR fname: str32;
  661.     str:STRING;
  662. BEGIN
  663.   st.strcpy(fname,GuiData.fontName);
  664.   str:=st.strchr (fname, '.'); str^[0]:=0C;
  665.   IF scr AND NOT end THEN FPrintF2 (fdef, ADR("  %s%ld:g.TextAttr;\n\n"),
  666.                                     ADR(fname), GuiData.font.ta_YSize);
  667.   ELSE
  668.     IF end THEN
  669.       FPrintF2 (file,ADR("BEGIN\n  %s%ld:="),ADR(fname),GuiData.font.ta_YSize);
  670.       FPrintF4 (file, ADR(' [y.ADR ("%s"), %ld, SHORTSET(0%02lxH), SHORTSET(0%02lxH) ];\n'),
  671.                 ADR(GuiData.fontName), GuiData.font.ta_YSize, CAST(SHORTINT,GuiData.font.ta_Style), CAST(SHORTINT,GuiData.font.ta_Flags));
  672.     ELSE
  673.       FPrintF2 (file, ADR("VAR %s%ld: g.TextAttr;\n"),ADR(fname),GuiData.font.ta_YSize);
  674.     END;
  675.   END;
  676. END WriteTextAttr;
  677.  
  678. (* --- Write the Window Tags. *)
  679. PROCEDURE WriteWindow (pw: gtx.ProjectWindowPtr);
  680. BEGIN
  681.   IF port IN MConfig THEN
  682.     FPrintF (file, ADR("  %sWnd := OpenWindowTags ( NIL,\n"), ADR(pw^.name));
  683.   ELSE
  684.     FPrintF (file, ADR("  %sWnd := I.OpenWindowTags ( NIL,\n"), ADR(pw^.name));
  685.   END;
  686.   IF (gtx.FontAdapt IN MainConfig.configFlags0) OR (mouse IN MConfig) THEN
  687.     FPutS (file, "                I.WA_Left,          wleft,\n");
  688.     FPutS (file, "                I.WA_Top,           wtop,\n");
  689.   ELSE
  690.     FPrintF (file, ADR("                I.WA_Left,          %sLeft,\n"), ADR(pw^.name));
  691.     FPrintF (file, ADR("                I.WA_Top,           %sTop,\n"), ADR(pw^.name));
  692.   END;
  693.  
  694.   IF ~(gtx.FontAdapt IN MainConfig.configFlags0) THEN
  695.     IF gtx.InnerWidth IN pw^.tagFlags THEN
  696.       FPutS (file, "                I.WA_InnerWidth,    ");
  697.     ELSE
  698.       FPutS (file, "                I.WA_Width,         ");
  699.     END;
  700.  
  701.     FPrintF (file, ADR("%sWidth,\n"), ADR(pw^.name));
  702.  
  703.     IF gtx.InnerHeight IN pw^.tagFlags THEN
  704.       FPutS (file, "                I.WA_InnerHeight,   ");
  705.     ELSE
  706.       FPutS (file, "                I.WA_Height,        ");
  707.     END;
  708.  
  709.     FPrintF (file, ADR("%sHeight"), ADR(pw^.name));
  710.     IF ~(gtx.InnerHeight IN pw^.tagFlags) THEN FPutS (file, " + offy") END;
  711.     FPutS (file, ",\n");
  712.  
  713.   ELSE
  714. (*  FPutS (file, "                I.WA_Width,         ww + OffX + Scr^.WBorRight,\n");
  715.     FPutS (file, "                I.WA_Height,        wh + OffY + Scr^.WBorBottom,\n");
  716. *)
  717.     FPutS (file, "                I.WA_InnerWidth,    ww,\n");
  718.     FPutS (file, "                I.WA_InnerHeight,   wh,\n");
  719.   END;
  720.  
  721.   FPutS (file, "                I.WA_IDCMP,         ");
  722.   WriteIDCMPFlags (pw^.idcmp+I.REFRESHWINDOW, pw);
  723.  
  724.   FPutS (file, "                I.WA_Flags,         ");
  725.   WriteWindowFlags (pw^.windowFlags);
  726.  
  727.   FPutS (file, "                I.WA_NewLookMenus,  TRUE,\n");
  728.  
  729.   IF ~(I.BACKDROP <= pw^.windowFlags) THEN
  730.     IF st.strlen (pw^.windowTitle) > 0 THEN
  731.       FPrintF (file, ADR('                I.WA_Title,         "%s",\n'), ADR(pw^.windowTitle[0]));
  732.     END;
  733.   END;
  734.  
  735.   IF st.strlen (pw^.screenTitle) > 0 THEN
  736.     FPrintF (file, ADR('                I.WA_ScreenTitle,   "%s",\n'), ADR(pw^.screenTitle[0]));
  737.   END;
  738.  
  739.   IF gtx.Custom IN GuiData.flags0 THEN
  740.     FPutS (file, "                I.WA_CustomScreen,  Scr,\n");
  741.   ELSIF gtx.Public IN GuiData.flags0 THEN
  742.     FPutS (file, "                I.WA_PubScreen,     Scr,\n");
  743.   END;
  744.  
  745.   IF I.WINDOWSIZING <= pw^.windowFlags THEN
  746.     IF gtx.GTX_TagInArray (I.WA_MinWidth, u.TagPtr(pw^.tags)) THEN
  747.       FPrintF (file, ADR("                I.WA_MinWidth,      %ld,\n"), u.GetTagData (I.WA_MinWidth, NIL, pw^.tags));
  748.     END;
  749.     IF gtx.GTX_TagInArray (I.WA_MinHeight, u.TagPtr(pw^.tags)) THEN
  750.       FPrintF (file, ADR("                I.WA_MinHeight,     %ld,\n"), u.GetTagData (I.WA_MinHeight, NIL, pw^.tags));
  751.     END;
  752.     IF gtx.GTX_TagInArray (I.WA_MaxWidth, u.TagPtr(pw^.tags)) THEN
  753.       FPrintF (file, ADR("                I.WA_MaxWidth,      %ld,\n"), u.GetTagData (I.WA_MaxWidth, NIL, pw^.tags));
  754.     END;
  755.     IF gtx.GTX_TagInArray (I.WA_MaxHeight, u.TagPtr(pw^.tags)) THEN
  756.       FPrintF (file, ADR("                I.WA_MaxHeight,     %ld,\n"), u.GetTagData (I.WA_MaxHeight, NIL, pw^.tags));
  757.     END;
  758.   ELSE
  759.     IF LONGSET{gtx.Zoom,gtx.DefaultZoom} * pw^.tagFlags # LONGSET{} THEN
  760.       FPrintF (file, ADR("                I.WA_Zoom,          y.ADR (%sZoom),\n"), ADR(pw^.name));
  761.     END;
  762.   END;
  763.  
  764.   IF (NOT (raster IN MConfig)) AND (pw^.gadgets.head^.succ # NIL) THEN
  765.     FPrintF (file, ADR('                I.WA_Gadgets,       %sGList,\n'),ADR(pw^.name));
  766.   END;
  767.   IF gtx.MouseQueue IN pw^.tagFlags THEN
  768.     FPrintF (file, ADR("                I.WA_MouseQueue,    %ld,\n"), pw^.mouseQueue);
  769.   END;
  770.   IF gtx.RptQueue IN pw^.tagFlags THEN
  771.     FPrintF (file, ADR("                I.WA_RptQueue,      %ld,\n"), pw^.rptQueue);
  772.   END;
  773.   IF gtx.AutoAdjust IN pw^.tagFlags THEN
  774.     FPutS (file, "                I.WA_AutoAdjust,    TRUE,\n");
  775.   END;
  776.   IF gtx.FallBack IN pw^.tagFlags THEN
  777.     FPutS (file, "                I.WA_PubScreenFallBack, TRUE,\n");
  778.   END;
  779.  
  780.   FPutS (file, "                u.TAG_DONE);\n");
  781.   FPrintF (file, ADR("  IF %sWnd = NIL THEN RETURN 20 END;\n\n"), ADR(pw^.name));
  782. END WriteWindow;
  783.  
  784. (* --- Write the Screen Tags and screen specific data. *)
  785. PROCEDURE WriteSTags (end:BOOLEAN);
  786. VAR cnt: INTEGER;
  787. BEGIN
  788.   IF GuiData.colors[0].ColorIndex # -1 THEN
  789.     IF end THEN
  790.       FPutS (file, "  ScreenColors := [\n");
  791.       cnt:=0;
  792.       WHILE GuiData.colors[cnt].ColorIndex # -1 DO
  793.         FPrintF4 (file, ADR("    [%2ld, 0%02lxH, 0%02lxH, 0%02lxH],\n"),
  794.                   GuiData.colors[cnt].ColorIndex, GuiData.colors[cnt].Red, GuiData.colors[cnt].Green, GuiData.colors[cnt].Blue);
  795.         INC (cnt);
  796.       END;
  797.       FPutS (file, "    [-1, 000H, 000H, 000H] ];\n");
  798.     ELSE
  799.       cnt:=0;
  800.       WHILE (cnt<32) AND (GuiData.colors[cnt].ColorIndex#-1) DO INC (cnt); END;
  801.       FPrintF (file, ADR("TYPE ColorArray = ARRAY [0..%ld] OF I.ColorSpec;\n"),cnt);
  802.       FPutS (file, "VAR ScreenColors : ColorArray;\n");
  803.     END;
  804.   END;
  805.  
  806.   IF end THEN
  807.     FPutS (file, "  DriPens := [");
  808.     cnt:=0;
  809.     WHILE (cnt<gtx.MaxDriPens) AND (GuiData.driPens[cnt] # -1) DO
  810.       FPrintF (file, ADR("%ld,"), GuiData.driPens[cnt]);
  811.       INC (cnt);       (*| Es fehlen: OS 3.0 Dri-Pens *)
  812.     END;
  813.     FPutS (file, "-1];\n");
  814.   ELSE
  815.     cnt:=0;
  816.     WHILE (cnt<gtx.MaxDriPens) AND (GuiData.driPens[cnt]#-1) DO INC (cnt); END;
  817.     FPrintF (file, ADR("TYPE DriPenArray = ARRAY [0..%ld] OF INTEGER;\n"),cnt);
  818.     FPutS (file, "VAR DriPens : DriPenArray;\n");
  819.   END;
  820. END WriteSTags;
  821.  
  822. (* --- Write the Modula IntuiText structures. *)
  823.  
  824. PROCEDURE CountITexts (itxt: I.IntuiTextPtr): INTEGER;
  825. VAR cnt: INTEGER;
  826. BEGIN cnt:= 0; WHILE itxt # NIL DO INC(cnt); itxt := itxt^.NextText; END; RETURN (cnt);
  827. END CountITexts;
  828.  
  829. PROCEDURE WriteIText ();
  830. VAR pw: gtx.ProjectWindowPtr;
  831.     t: I.IntuiTextPtr;
  832.     i, bleft, btop, n: INTEGER;
  833.     fname: str32;
  834.     str:STRING;
  835. BEGIN
  836.   i := 1; n := 0;
  837.   st.strcpy (fname,GuiData.fontName);
  838.   str:=st.strchr (fname, '.'); str^[0]:=0C;
  839.  
  840.   pw := Projects.head;
  841.   LOOP
  842.     IF pw^.succ = NIL THEN EXIT ELSE
  843.       IF pw^.windowText # NIL THEN FPutS (file, "VAR\n"); EXIT END;
  844.       pw := pw^.succ;
  845.     END;
  846.   END;
  847.  
  848.   pw := Projects.head;
  849.   WHILE pw^.succ # NIL DO
  850.     bleft := pw^.leftBorder; btop := pw^.topBorder;
  851.     t := pw^.windowText;
  852.     IF t # NIL THEN
  853.       FPrintF2 (file, ADR("  %sIText: ARRAY [0..%ld] OF I.IntuiText;\n"), ADR(pw^.name), CountITexts (t)-1);
  854.     END;
  855.     pw := pw^.succ;
  856.   END;
  857. END WriteIText;
  858.  
  859. (* --- Write the NewGadget arrays. *)
  860. PROCEDURE WriteGArray (end:BOOLEAN);
  861. VAR pw: gtx.ProjectWindowPtr;
  862.     g: gtx.ExtNewGadgetPtr;
  863.     ng: gt.NewGadgetPtr;
  864.     bleft, btop: INTEGER;
  865. BEGIN
  866.   pw := Projects.head;
  867.   WHILE pw^.succ # NIL DO
  868.     bleft := pw^.leftBorder; btop := pw^.topBorder;
  869.     IF pw^.gadgets.head^.succ # NIL THEN
  870.       IF end THEN
  871.         FPrintF2 (file, ADR("  %sNGad := GetMem (SIZE(%sNGadArray));\n"),
  872.                   ADR(pw^.name), ADR(pw^.name));
  873.         FPrintF (file, ADR("  %sNGad^ := [\n"),ADR(pw^.name));
  874.         g := pw^.gadgets.head;
  875.         WHILE g^.succ # NIL DO
  876.           ng := ADR(g^.newGadget);
  877.           FPrintF4 (file, ADR("    [%ld, %ld, %ld, %ld, "), ng^.ng_LeftEdge - bleft, ng^.ng_TopEdge - btop, ng^.ng_Width, ng^.ng_Height);
  878.           IF (ng^.ng_GadgetText # NIL) & (st.strlen (ng^.ng_GadgetText) > 0) THEN
  879.             FPrintF (file, ADR('"%s", NIL, '), ng^.ng_GadgetText);
  880.           ELSE FPutS (file, "NIL, NIL, "); END;
  881.           FPrintF (file, ADR("GD%s"), ADR(g^.gadgetLabel));
  882.           IF ng^.ng_Flags # {} THEN
  883.             FPutS (file,", ");
  884.             WritePlaceFlags (ng^.ng_Flags);
  885.           END;
  886.           FPutS (file, "],\n");
  887.           g := g^.succ;
  888.         END;
  889.         SeekBack (2);
  890.         FPutS (file, " ];\n");
  891.       ELSE
  892.         FPrintF2 (file, ADR("TYPE %sNGadArray = ARRAY [0..%sCNT-1] OF gt.NewGadget;\n"),
  893.                   ADR(pw^.name), ADR(pw^.name));
  894.         FPrintF2 (file, ADR("VAR %sNGad : POINTER TO %sNGadArray;\n"),
  895.                   ADR(pw^.name), ADR(pw^.name));
  896.       END;
  897.     END;
  898.     pw := pw^.succ;
  899.   END;
  900. END WriteGArray;
  901.  
  902. PROCEDURE WriteGadHeader (pw: gtx.ProjectWindowPtr);
  903. BEGIN
  904.   FPrintF (file, ADR("PROCEDURE Create%sGadgets (): INTEGER;\n"), ADR(pw^.name));
  905.   FPrintF (fdef, ADR("PROCEDURE Create%sGadgets (): INTEGER;\n"), ADR(pw^.name));
  906.  
  907.   FPutS (file, "VAR\n  ng: gt.NewGadget;\n  gad: I.GadgetPtr;\n");
  908.   IF JoinedInWindow THEN FPutS (file, "  tmp, help: u.TagItemPtr;\n"); END;
  909.  
  910.   FPutS (file, "  lc, tc");
  911.  
  912.   IF gtx.FontAdapt IN MainConfig.configFlags0 THEN
  913.     FPutS (file, ": INTEGER;\nBEGIN\n");
  914.     FPrintF2 (file, ADR("  ComputeFont (%sWidth, %sHeight);\n\n"), ADR(pw^.name), ADR(pw^.name));
  915.   ELSE
  916.     FPutS (file, ", offx, offy: INTEGER;\nBEGIN\n");
  917.     IF I.BACKDROP <= pw^.windowFlags THEN FPutS (file, "  offx := 0; ");
  918.                                      ELSE FPutS (file, "  offx := Scr^.WBorLeft; ");
  919.     END;
  920.     FPutS (file, "offy := Scr^.WBorTop + Scr^.RastPort.TxHeight + 1;\n\n");
  921.   END;
  922. END WriteGadHeader;
  923.  
  924. (* --- Write the routine header. *)
  925. PROCEDURE WriteHeader (pw: gtx.ProjectWindowPtr);
  926. BEGIN
  927.   FPrintF (file, ADR("PROCEDURE Open%sWindow ("),ADR(pw^.name));
  928.   FPrintF (fdef, ADR("PROCEDURE Open%sWindow ("),ADR(pw^.name));
  929.   IF pw^.gadgets.head^.succ # NIL THEN FPutS2 (ADR("createGads: BOOLEAN")); END;
  930.   FPutS2 (ADR("): INTEGER;\n"));
  931.  
  932.   FPutS (file, "VAR ");
  933.   IF pw^.gadgets.head^.succ # NIL THEN FPutS (file, "ret, "); END;
  934.  
  935.   IF gtx.FontAdapt IN MainConfig.configFlags0 THEN
  936.     FPutS  (file, "wleft, wtop, ww, wh: INTEGER;\n");
  937.     FPutS (file, "BEGIN\n");
  938.     IF NOT (mouse IN MConfig) THEN
  939.       FPrintF2 (file, ADR("  wleft := %sLeft; wtop := %sTop;\n\n"), ADR(pw^.name), ADR(pw^.name));
  940.     END;
  941.  
  942.     FPrintF2 (file, ADR("  ComputeFont (%sWidth, %sHeight);\n\n"), ADR(pw^.name), ADR(pw^.name));
  943.     FPrintF2 (file, ADR("  ww := ComputeX (%sWidth);\n  wh := ComputeY (%sHeight);\n\n"), ADR(pw^.name), ADR(pw^.name));
  944.  
  945.     IF mouse IN MConfig THEN
  946.       FPutS (file, "  wleft := Scr^.MouseX - (ww DIV 2);\n  wtop  := Scr^.MouseY - (wh DIV 2);\n\n");
  947.     ELSE
  948.       FPutS (file, "  IF wleft + ww + OffX + Scr^.WBorRight > Scr^.Width THEN\n    wleft := Scr^.Width - ww;\n  END;\n");
  949.       FPutS (file, "  IF wtop + wh + OffY + Scr^.WBorBottom > Scr^.Height THEN\n    wtop := Scr^.Height - wh;\n  END;\n\n");
  950.     END;
  951.  
  952.     IF SysFont IN MConfig THEN
  953.       FPrintF2 (file, ADR("  %sFont := df.OpenDiskFont (Font);\n  IF %sFont = NIL THEN RETURN 5 END;\n\n"), ADR(pw^.name), ADR(pw^.name));
  954.     END;
  955.   ELSE
  956.     IF ~(gtx.InnerHeight IN pw^.tagFlags) THEN FPutS (file, "offy, ") END;
  957.     IF mouse IN MConfig THEN FPutS (file, "wleft, wtop, ") END;
  958.     SeekBack (2);
  959.     FPutS (file, ": INTEGER;\nBEGIN\n");
  960.     IF ~(gtx.InnerHeight IN pw^.tagFlags) THEN
  961.        FPutS (file, "  offy := Scr^.WBorTop + Scr^.RastPort.TxHeight + 1;\n");
  962.     END;
  963.     IF mouse IN MConfig THEN
  964.       FPrintF2 (file, ADR("  wleft := Scr^.MouseX - (%sWidth DIV 2);\n  wtop  := Scr^.MouseY - ((%sHeight"), ADR(pw^.name), ADR(pw^.name));
  965.       IF ~(gtx.InnerHeight IN pw^.tagFlags) THEN FPutS (file, " + offy") END;
  966.       FPutS (file, ") DIV 2);\n\n");
  967.     END;
  968. (*  IF I.BACKDROP <= pw^.windowFlags THEN FPutS (file, "  offx := 0; ");
  969.                                      ELSE FPutS (file, "  offx := Scr^.WBorLeft; "); END; *)
  970.   END;
  971.  
  972.   IF pw^.gadgets.head^.succ # NIL THEN
  973.     FPrintF (file, ADR("  IF createGads THEN\n    ret := Create%sGadgets(); IF ret # 0 THEN RETURN ret END;\n  END;\n\n"),ADR(pw^.name));
  974.   END;
  975. END WriteHeader;
  976.  
  977. (* --- Write the gadget type array. *)
  978. PROCEDURE WriteGTypes (end:BOOLEAN);
  979. VAR pw: gtx.ProjectWindowPtr;
  980.     eng: gtx.ExtNewGadgetPtr;
  981. BEGIN
  982.   pw := Projects.head;
  983.   WHILE pw^.succ # NIL DO
  984.     IF pw^.gadgets.head^.succ # NIL THEN
  985.       IF end THEN
  986.         FPrintF (file, ADR("  %sGTypes := [\n"),ADR(pw^.name));
  987.         eng := pw^.gadgets.head;
  988.         WHILE eng^.succ # NIL DO FPrintF (file, ADR("    gt.%s_KIND,\n"), goKinds[eng^.kind]); eng := eng^.succ; END;
  989.         SeekBack (2);
  990.         FPutS (file, " ];\n");
  991.       ELSE
  992.         FPrintF2 (file, ADR("TYPE %sGTypesArray = ARRAY [0..%sCNT-1] OF INTEGER;\n"),
  993.                   ADR(pw^.name), ADR(pw^.name));
  994.         FPrintF2 (file, ADR("VAR %sGTypes : %sGTypesArray;\n"),
  995.                   ADR(pw^.name), ADR(pw^.name));
  996.       END;
  997.     END;
  998.     pw := pw^.succ;
  999.   END;
  1000. END WriteGTypes;
  1001.  
  1002. VAR TagNumbers:POINTER TO ARRAY OF LONGINT;
  1003.     TagNr:INTEGER;
  1004.  
  1005. PROCEDURE MarkTagNumber;
  1006. BEGIN
  1007.   TagNumbers^[TagNr]:=d.Seek (file,0,d.OFFSET_CURRENT);
  1008.   INC (TagNr);
  1009.   FPutS (file, "0000");
  1010. END MarkTagNumber;
  1011.  
  1012. PROCEDURE FixTagNumber (num: INTEGER);
  1013. VAR curpos: LONGINT;
  1014. BEGIN
  1015.   curpos := d.Seek (file, TagNumbers^[TagNr], d.OFFSET_BEGINNING);
  1016.   INC (TagNr);
  1017.   FPrintF (file,"%4ld",num);
  1018.   d.Seek (file, curpos, d.OFFSET_BEGINNING);
  1019. END FixTagNumber;
  1020.  
  1021. (* --- Write the gadget tagitem array. *)
  1022. PROCEDURE WriteGTags (end:BOOLEAN);
  1023. VAR pw: gtx.ProjectWindowPtr;
  1024.     g: gtx.ExtNewGadgetPtr;
  1025.     pnum,cnt: INTEGER;
  1026.     list: e.ListPtr;
  1027.     str: Pstr256;
  1028.     sj: BITSET;
  1029.     help:CARDINAL;
  1030. BEGIN
  1031.  IF NOT end THEN
  1032.    pw := Projects.head; pnum := 0;
  1033.    WHILE pw^.succ # NIL DO
  1034.      IF pw^.gadgets.head^.succ # NIL THEN INC (pnum); END;
  1035.      pw := pw^.succ;
  1036.    END; (* WHILE *)
  1037.    IF pnum>0 THEN
  1038.      TagNumbers:=m2.malloc (SIZE(LONGINT)*pnum);
  1039.      IF TagNumbers=NIL THEN m2._ErrorReq ("Not enought memory"," "); END;
  1040.    END;
  1041.  END;
  1042.  pw := Projects.head; pnum := 0; TagNr:=0;
  1043.  WHILE pw^.succ # NIL DO
  1044.   IF pw^.gadgets.head^.succ # NIL THEN
  1045.     g := pw^.gadgets.head;
  1046.     IF NOT end THEN
  1047.       FPrintF (file, ADR("TYPE %sGTagsArray = ARRAY [0.."),ADR(pw^.name));
  1048.       MarkTagNumber;
  1049.       FPutS (file, "] OF y.ADDRESS;\n");
  1050.       FPrintF2  (file, ADR("VAR %sGTags : POINTER TO %sGTagsArray;\n"),
  1051.                  ADR(pw^.name), ADR(pw^.name));
  1052.     ELSE
  1053.       FPrintF2  (file, ADR("  %sGTags := GetMem (SIZE(%sGTagsArray));\n"),
  1054.                  ADR(pw^.name), ADR(pw^.name));
  1055.       FPrintF (file, ADR("  %sGTags^ := [\n"),ADR(pw^.name));
  1056.       WHILE g^.succ # NIL DO
  1057.         FPutS (file, "    ");
  1058.  
  1059.         CASE g^.kind OF
  1060.             gt.CHECKBOX_KIND:
  1061.               IF gtx.GTX_TagInArray (gt.GTCB_Checked, u.TagPtr(g^.tags)) THEN
  1062.                 FPutS (file, "y.ADDRESS(gt.GTCB_Checked), ORD(TRUE), "); INC(cnt,2);
  1063.               END;
  1064.               FPutS (file, "y.ADDRESS(gt.GTCB_Scaled), ORD(TRUE), "); INC(cnt,2);
  1065.           | gt.CYCLE_KIND:
  1066.               FPrintF2 (file, ADR("y.ADDRESS(gt.GTCY_Labels), y.ADR (%s%ldLabels[0]), "), ADR(g^.gadgetLabel[0]), pnum); INC(cnt,2);
  1067.               IF gtx.GTX_TagInArray (gt.GTCY_Active, u.TagPtr(g^.tags)) THEN
  1068.                 FPrintF (file, ADR("y.ADDRESS(gt.GTCY_Active), %ld, "), u.GetTagData (gt.GTCY_Active, 0, g^.tags)); INC(cnt,2);
  1069.               END;
  1070.           | gt.INTEGER_KIND:
  1071.               IF gtx.GTX_TagInArray (LONGCARD(C.GA_TabCycle), u.TagPtr(g^.tags)) THEN
  1072.                 FPutS (file, "y.ADDRESS(C.GA_TabCycle), ORD(FALSE), "); INC(cnt,2);
  1073.               END;
  1074.               IF gtx.GTX_TagInArray (LONGCARD(C.STRINGA_ExitHelp), u.TagPtr(g^.tags)) THEN
  1075.                 FPutS (file, "y.ADDRESS(C.STRINGA_ExitHelp), ORD(TRUE), "); INC(cnt,2);
  1076.               END;
  1077.               FPrintF (file, ADR("y.ADDRESS(gt.GTIN_Number), %ld, "), u.GetTagData (gt.GTIN_Number, 0, g^.tags)); INC(cnt,2);
  1078.               FPrintF (file, ADR("y.ADDRESS(gt.GTIN_MaxChars), %ld, "), u.GetTagData (gt.GTIN_MaxChars, 5, CAST(u.TagItemPtr,g^.tags))); INC(cnt,2);
  1079.               help:=u.GetTagData (C.STRINGA_Justification, 0, g^.tags);
  1080.               sj:=BITSET(help);
  1081.               IF sj # {} THEN
  1082.                 FPutS (file, "y.ADDRESS(C.STRINGA_Justification), y.ADDRESS(");
  1083.                 IF I.STRINGCENTER <= sj THEN FPutS (file, "I.STRINGCENTER), ");
  1084.                                         ELSE FPutS (file, "I.STRINGRIGHT), ");
  1085.                 END;
  1086.                 INC(cnt,2);
  1087.               END;
  1088.           | gt.LISTVIEW_KIND:
  1089.               list := CAST(ADDRESS,u.GetTagData (gt.GTLV_Labels, NIL, g^.tags));
  1090.               IF list # NIL THEN
  1091.                 IF (list^.lh_Head^.ln_Succ # NIL)
  1092.                  (*|  & (list^.head^.succ^.succ # NIL) *) THEN
  1093.                     FPrintF2 (file, ADR("y.ADDRESS(gt.GTLV_Labels), y.ADR (%s%ldList), "), ADR(g^.gadgetLabel[0]), pnum);
  1094.                     INC(cnt,2);
  1095.                 END;
  1096.               END;
  1097.               IF gtx.NeedLock IN g^.flags THEN
  1098.                 FPutS (file, "y.ADDRESS(gt.GTLV_ShowSelected), 1, "); INC(cnt,2);
  1099.               ELSIF gtx.GTX_TagInArray (gt.GTLV_ShowSelected,u.TagPtr(g^.tags)) THEN
  1100.                 FPutS (file, "y.ADDRESS(gt.GTLV_ShowSelected), NIL, "); INC(cnt,2);
  1101.               END;
  1102.               IF gtx.GTX_TagInArray (gt.GTLV_ScrollWidth, u.TagPtr(g^.tags)) THEN
  1103.                 FPrintF (file, ADR("y.ADDRESS(gt.GTLV_ScrollWidth), %ld, "), u.GetTagData (gt.GTLV_ScrollWidth, 0, CAST(u.TagItemPtr,g^.tags))); INC(cnt,2);
  1104.               END;
  1105.               IF gtx.GTX_TagInArray (gt.GTLV_ReadOnly, u.TagPtr(g^.tags)) THEN
  1106.                 FPutS (file, "y.ADDRESS(gt.GTLV_ReadOnly), ORD(TRUE), "); INC(cnt,2);
  1107.               END;
  1108.               IF gtx.GTX_TagInArray (C.LAYOUTA_Spacing, u.TagPtr(g^.tags)) THEN
  1109.                 FPrintF (file, ADR("y.ADDRESS(C.LAYOUTA_Spacing), %ld, "), u.GetTagData (C.LAYOUTA_Spacing, 0, g^.tags)); INC(cnt,2);
  1110.               END;
  1111.           | gt.MX_KIND:
  1112.               FPrintF2 (file, ADR("y.ADDRESS(gt.GTMX_Labels), y.ADR (%s%ldLabels[0]), "), ADR(g^.gadgetLabel[0]), pnum); INC(cnt,2);
  1113.               IF gtx.GTX_TagInArray (gt.GTMX_Spacing, u.TagPtr(g^.tags)) THEN
  1114.                 FPrintF (file, ADR("y.ADDRESS(gt.GTMX_Spacing), %ld, "), u.GetTagData (gt.GTMX_Spacing, 0, g^.tags)); INC(cnt,2);
  1115.               END;
  1116.               IF gtx.GTX_TagInArray (gt.GTMX_Active, u.TagPtr(g^.tags)) THEN
  1117.                 FPrintF (file, ADR("y.ADDRESS(gt.GTMX_Active), %ld, "), u.GetTagData (gt.GTMX_Active, 0, g^.tags)); INC(cnt,2);
  1118.               END;
  1119.               FPutS (file, "y.ADDRESS(gt.GTMX_Scaled), ORD(TRUE), "); INC(cnt,2);
  1120.           | gt.PALETTE_KIND:
  1121.               FPrintF (file, ADR("y.ADDRESS(gt.GTPA_Depth), %ld, "), u.GetTagData (gt.GTPA_Depth, 1, g^.tags)); INC(cnt,2);
  1122.               IF gtx.GTX_TagInArray (gt.GTPA_IndicatorWidth, u.TagPtr(g^.tags)) THEN
  1123.                 FPrintF (file, ADR("y.ADDRESS(gt.GTPA_IndicatorWidth), %ld, "), u.GetTagData (gt.GTPA_IndicatorWidth, NIL, g^.tags)); INC(cnt,2);
  1124.               END;
  1125.               IF gtx.GTX_TagInArray (gt.GTPA_IndicatorHeight, u.TagPtr(g^.tags)) THEN
  1126.                 FPrintF (file, ADR("y.ADDRESS(gt.GTPA_IndicatorHeight), %ld, "), u.GetTagData (gt.GTPA_IndicatorHeight, NIL, g^.tags)); INC(cnt,2);
  1127.               END;
  1128.               IF gtx.GTX_TagInArray (gt.GTPA_Color, u.TagPtr(g^.tags)) THEN
  1129.                 FPrintF (file, ADR("y.ADDRESS(gt.GTPA_Color), %ld, "), u.GetTagData (gt.GTPA_Color, 1, g^.tags)); INC(cnt,2);
  1130.               END;
  1131.               IF gtx.GTX_TagInArray (gt.GTPA_ColorOffset, u.TagPtr(g^.tags)) THEN
  1132.                 FPrintF (file, ADR("y.ADDRESS(gt.GTPA_ColorOffset), %ld, "), u.GetTagData (gt.GTPA_ColorOffset, 0, g^.tags)); INC(cnt,2);
  1133.               END;
  1134.           | gt.SCROLLER_KIND:
  1135.               IF gtx.GTX_TagInArray (gt.GTSC_Top, u.TagPtr(g^.tags)) THEN
  1136.                 FPrintF (file, ADR("y.ADDRESS(gt.GTSC_Top), %ld, "), u.GetTagData (gt.GTSC_Top, NIL, g^.tags)); INC(cnt,2);
  1137.               END;
  1138.               IF gtx.GTX_TagInArray (gt.GTSC_Total, u.TagPtr(g^.tags)) THEN
  1139.                 FPrintF (file, ADR("y.ADDRESS(gt.GTSC_Total), %ld, "), u.GetTagData (gt.GTSC_Total, NIL, g^.tags)); INC(cnt,2);
  1140.               END;
  1141.               IF gtx.GTX_TagInArray (gt.GTSC_Visible, u.TagPtr(g^.tags)) THEN
  1142.                 FPrintF (file, ADR("y.ADDRESS(gt.GTSC_Visible), %ld, "), u.GetTagData (gt.GTSC_Visible, NIL, g^.tags)); INC(cnt,2);
  1143.               END;
  1144.               IF gtx.GTX_TagInArray (gt.GTSC_Arrows, u.TagPtr(g^.tags)) THEN
  1145.                 FPrintF (file, ADR("y.ADDRESS(gt.GTSC_Arrows), %ld, "), u.GetTagData (gt.GTSC_Arrows, 0, g^.tags)); INC(cnt,2);
  1146.               END;
  1147.               IF gtx.GTX_TagInArray (LONGCARD(C.PGA_Freedom), u.TagPtr(g^.tags)) THEN
  1148.                 FPutS (file, "y.ADDRESS(C.PGA_Freedom), C.LORIENT_VERT, "); INC(cnt,2);
  1149.               ELSE
  1150.                 FPutS (file, "y.ADDRESS(C.PGA_Freedom), C.LORIENT_HORIZ, "); INC(cnt,2);
  1151.               END;
  1152.               IF gtx.GTX_TagInArray (LONGCARD(C.GA_Immediate), u.TagPtr(g^.tags)) THEN
  1153.                 FPutS (file, "y.ADDRESS(C.GA_Immediate), ORD(TRUE), "); INC(cnt,2);
  1154.               END;
  1155.               IF gtx.GTX_TagInArray (LONGCARD(C.GA_RelVerify), u.TagPtr(g^.tags)) THEN
  1156.                 FPutS (file, "y.ADDRESS(C.GA_RelVerify), ORD(TRUE), "); INC(cnt,2);
  1157.               END;
  1158.           | gt.SLIDER_KIND:
  1159.               IF gtx.GTX_TagInArray (gt.GTSL_Min, u.TagPtr(g^.tags)) THEN
  1160.                 FPrintF (file, ADR("y.ADDRESS(gt.GTSL_Min), %ld, "), u.GetTagData (gt.GTSL_Min, NIL, g^.tags)); INC(cnt,2);
  1161.               END;
  1162.               IF gtx.GTX_TagInArray (gt.GTSL_Max, u.TagPtr(g^.tags)) THEN
  1163.                 FPrintF (file, ADR("y.ADDRESS(gt.GTSL_Max), %ld, "), u.GetTagData (gt.GTSL_Max, NIL, g^.tags)); INC(cnt,2);
  1164.               END;
  1165.               IF gtx.GTX_TagInArray (gt.GTSL_Level, u.TagPtr(g^.tags)) THEN
  1166.                 FPrintF (file, ADR("y.ADDRESS(gt.GTSL_Level), %ld, "), u.GetTagData (gt.GTSL_Level, NIL, g^.tags)); INC(cnt,2);
  1167.               END;
  1168.               IF gtx.GTX_TagInArray (gt.GTSL_MaxLevelLen, u.TagPtr(g^.tags)) THEN
  1169.                 FPrintF (file, ADR("y.ADDRESS(gt.GTSL_MaxLevelLen), %ld, "), u.GetTagData (gt.GTSL_MaxLevelLen, NIL, g^.tags)); INC(cnt,2);
  1170.               END;
  1171.               IF gtx.GTX_TagInArray (gt.GTSL_LevelFormat, u.TagPtr(g^.tags)) THEN
  1172.                 FPrintF (file, ADR('y.ADDRESS(gt.GTSL_LevelFormat), y.ADR ("%s"), '), u.GetTagData (gt.GTSL_LevelFormat, NIL, g^.tags)); INC(cnt,2);
  1173.               END;
  1174.               IF gtx.GTX_TagInArray (gt.GTSL_LevelPlace, u.TagPtr(g^.tags)) THEN
  1175.                 FPutS (file, "y.ADDRESS(gt.GTSL_LevelPlace), y.ADDRESS(y.CAST(CARDINAL,"); INC(cnt,2);
  1176.                 WritePlaceFlags (LONGSET(u.GetTagData (gt.GTSL_LevelPlace, NIL, g^.tags)));
  1177.                 FPutS (file, ")), ");
  1178.               END;
  1179.               IF gtx.GTX_TagInArray (C.PGA_Freedom, u.TagPtr(g^.tags)) THEN
  1180.                 FPutS (file, "y.ADDRESS(C.PGA_Freedom), C.LORIENT_VERT, "); INC(cnt,2);
  1181.               ELSE
  1182.                 FPutS (file, "y.ADDRESS(C.PGA_Freedom), C.LORIENT_HORIZ, "); INC(cnt,2);
  1183.               END;
  1184.               IF gtx.GTX_TagInArray (C.GA_Immediate, u.TagPtr(g^.tags)) THEN
  1185.                 FPutS (file, "y.ADDRESS(C.GA_Immediate), ORD(TRUE), "); INC(cnt,2);
  1186.               END;
  1187.               IF gtx.GTX_TagInArray (C.GA_RelVerify, u.TagPtr(g^.tags)) THEN
  1188.                 FPutS (file, "y.ADDRESS(C.GA_RelVerify), ORD(TRUE), "); INC(cnt,2);
  1189.               END;
  1190.           | gt.STRING_KIND:
  1191.               IF gtx.GTX_TagInArray (C.GA_TabCycle, u.TagPtr(g^.tags)) THEN
  1192.                 FPutS (file, "y.ADDRESS(C.GA_TabCycle), ORD(FALSE), "); INC(cnt,2);
  1193.               END;
  1194.               IF gtx.GTX_TagInArray (C.STRINGA_ExitHelp, u.TagPtr(g^.tags)) THEN
  1195.                 FPutS (file, "y.ADDRESS(C.STRINGA_ExitHelp), ORD(TRUE), "); INC(cnt,2);
  1196.               END;
  1197.               str := ADDRESS(u.GetTagData (gt.GTST_String, NIL, g^.tags));
  1198.               IF (str # NIL) & (st.strlen (ADDRESS(str)) > 0) THEN
  1199.                 FPrintF (file, ADR('y.ADDRESS(gt.GTST_String), y.ADR ("%s"), '), str); INC(cnt,2);
  1200.               END;
  1201.               FPrintF (file, ADR("y.ADDRESS(gt.GTST_MaxChars), %ld, "), u.GetTagData (gt.GTST_MaxChars, 5, g^.tags)); INC(cnt,2);
  1202.               help:=u.GetTagData (C.STRINGA_Justification, 0, g^.tags);
  1203.               sj:=BITSET(help);
  1204.               IF sj # {} THEN
  1205.                 FPutS (file, "y.ADDRESS(C.STRINGA_Justification), y.ADDRESS(");
  1206.                 IF I.STRINGCENTER <= sj THEN FPutS (file, "I.STRINGCENTER), ");
  1207.                                         ELSE FPutS (file, "I.STRINGRIGHT), ");
  1208.                 END;
  1209.                 INC(cnt,2);
  1210.               END;
  1211.           | gt.NUMBER_KIND:
  1212.               IF gtx.GTX_TagInArray (gt.GTNM_Number, u.TagPtr(g^.tags)) THEN
  1213.                 FPrintF (file, ADR("y.ADDRESS(gt.GTNM_Number), %ld, "), u.GetTagData (gt.GTNM_Number, 0, g^.tags)); INC(cnt,2);
  1214.               END;
  1215.               IF gtx.GTX_TagInArray (gt.GTNM_Border,u.TagPtr(g^.tags)) THEN
  1216.                 FPutS (file, "y.ADDRESS(gt.GTNM_Border), ORD(TRUE), "); INC(cnt,2);
  1217.               END;
  1218.           | gt.TEXT_KIND:
  1219.               str := ADDRESS(u.GetTagData (gt.GTTX_Text, NIL, g^.tags));
  1220.               IF (str # NIL) & (st.strlen (ADDRESS(str)) > 0) THEN
  1221.                 FPrintF (file, ADR('y.ADDRESS(gt.GTTX_Text), y.ADR ("%s"), '), str); INC(cnt,2);
  1222.               END;
  1223.               IF gtx.GTX_TagInArray (gt.GTTX_Border, u.TagPtr(g^.tags)) THEN
  1224.                 FPutS (file, "y.ADDRESS(gt.GTTX_Border), ORD(TRUE), "); INC(cnt,2);
  1225.               END;
  1226.               IF gtx.GTX_TagInArray (gt.GTTX_CopyText, u.TagPtr(g^.tags)) THEN
  1227.                 FPutS (file, "y.ADDRESS(gt.GTTX_CopyText), ORD(TRUE), "); INC(cnt,2);
  1228.               END;
  1229.         ELSE
  1230.         END; (* CASE *)
  1231.         IF g^.kind # gt.GENERIC_KIND THEN
  1232.           IF gtx.GTX_TagInArray (gt.GT_Underscore, u.TagPtr(g^.tags)) THEN
  1233.             FPutS (file, "y.ADDRESS(gt.GT_Underscore), ORD ('_'), "); INC(cnt,2);
  1234.           END;
  1235.         END;
  1236.  
  1237.         IF gtx.GTX_TagInArray (C.GA_Disabled, u.TagPtr(g^.tags)) THEN
  1238.           FPutS (file, "y.ADDRESS(C.GA_Disabled), ORD(TRUE), "); INC(cnt,2);
  1239.         END;
  1240.  
  1241.         FPutS (file, "u.TAG_DONE,\n"); INC(cnt);
  1242.         g := g^.succ;
  1243.       END; (* WHILE *)
  1244.       SeekBack (2);
  1245.       FPutS (file, " ];\n");
  1246.       FixTagNumber (cnt-1);
  1247.     END;
  1248.   END;
  1249.   pw := pw^.succ; INC(pnum);
  1250.  END; (* WHILE *)
  1251. END WriteGTags;
  1252.  
  1253. (* --- Write the Modula Gadgets initialization. *)
  1254. PROCEDURE WriteGadgets (pw: gtx.ProjectWindowPtr);
  1255. VAR fname: str32;
  1256.     btop, bleft: INTEGER;
  1257.     str:STRING;
  1258. BEGIN
  1259.   btop := pw^.topBorder; bleft := pw^.leftBorder;
  1260.  
  1261.   st.strcpy (fname,GuiData.fontName);
  1262.   str:=st.strchr(fname,'.'); str^[0]:=0C;
  1263.  
  1264.   FPutS (file, "  lc := 0; tc := 0;\n");
  1265.   FPrintF (file, ADR("  WHILE lc < %sCNT DO\n"), ADR(pw^.name));
  1266.   FPrintF (file, ADR("    ng := %sNGad^[lc];\n"), ADR(pw^.name));
  1267.  
  1268.   FPutS (file, "    ng.ng_VisualInfo := VisualInfo;\n");
  1269.  
  1270.   IF gtx.FontAdapt IN MainConfig.configFlags0 THEN
  1271.     FPutS (file, "    ng.ng_TextAttr   := Font;\n    ng.ng_LeftEdge   := OffX + ComputeX (ng.ng_LeftEdge);\n    ng.ng_TopEdge    := OffY + ComputeY (ng.ng_TopEdge);\n");
  1272.     FPutS (file, "    ng.ng_Width      := ComputeX (ng.ng_Width);\n    ng.ng_Height     := ComputeY (ng.ng_Height);\n\n");
  1273.   ELSE
  1274.     FPrintF2 (file, ADR("    ng.ng_TextAttr   := y.ADR (%s%ld);\n"), ADR(fname), GuiData.font.ta_YSize);
  1275.     FPutS (file, "    INC (ng.ng_LeftEdge, offx);\n    INC (ng.ng_TopEdge, offy);\n");
  1276.   END;
  1277.  
  1278.   IF JoinedInWindow THEN
  1279.     FPrintF (file, ADR("    help := u.CloneTagItems (y.ADR (%sGTags^[tc]));\n"), ADR(pw^.name));
  1280.     FPutS (file, "    IF help = NIL THEN RETURN 8 END;\n");
  1281.     FPrintF (file, ADR("    IF %sGTypes[lc] = gt.LISTVIEW_KIND THEN\n"), ADR(pw^.name));
  1282.     FPutS (file,"      tmp := u.FindTagItem (gt.GTLV_ShowSelected, help);\n      IF tmp # NIL THEN\n");
  1283.     FPutS (file,"        IF tmp^[0].ti_Data # 0 THEN tmp^[0].ti_Data := y.ADDRESS(gad) END;\n      END;\n");
  1284.     FPutS (file, "    END; (* IF *)\n");
  1285.     FPrintF (file,ADR("    gad := gt.CreateGadgetA (%sGTypes[lc], gad, ng, help);\n    u.FreeTagItems (help);\n"), ADR(pw^.name));
  1286.   ELSE
  1287.     FPrintF2 (file,ADR("    gad := gt.CreateGadgetA (%sGTypes[lc], gad, ng, y.ADR (%sGTags^[tc]));\n"), ADR(pw^.name), ADR(pw^.name));
  1288.   END; (* IF *)
  1289.  
  1290.   FPrintF (file,ADR("    IF gad = NIL THEN RETURN 2 END;\n    %sGadgets[lc] := gad;\n\n"), ADR(pw^.name));
  1291.  
  1292.   IF GetFileInWindow THEN
  1293.     FPrintF (file, ADR("    IF %sGTypes[lc] = gt.GENERIC_KIND THEN\n      INCL (gad^.Flags, I.GADGIMAGE+I.GADGHIMAGE);\n"),ADR(pw^.name));
  1294.     FPrintF (file, ADR("      IF u.FindTagItem (C.GA_Disabled,y.ADR (%sGTags^[tc]))#NIL THEN\n        INCL (gad^.Flags, I.GADGDISABLED);\n      END;\n"), ADR(pw^.name));
  1295.     FPrintF2 (file, ADR("      INCL (gad^.Activation, I.RELVERIFY);\n      gad^.GadgetRender := %sGetImage;\n      gad^.SelectRender := %sGetImage;\n    END; (* IF *)\n\n"),
  1296.                     ADR(pw^.name), ADR(pw^.name));
  1297.   END;
  1298.  
  1299.   FPrintF (file, ADR("    WHILE %sGTags^[tc] # u.TAG_DONE DO INC (tc, 2) END;\n    INC (tc);\n\n"), ADR(pw^.name));
  1300.  
  1301.   FPutS (file, "    INC (lc);\n  END; (* WHILE *)\n");
  1302. END WriteGadgets;
  1303.  
  1304. BEGIN
  1305.   InitConsts;
  1306. END MGTools.
  1307.